#!/bin/env perl 
#
#
#
# Copyright CEA/DAM/DIF  (2008)
# contributeur : Philippe DENIEL   philippe.deniel@cea.fr
#                Thomas LEIBOVICI  thomas.leibovici@cea.fr
#
#
# PUT LGLP HERE
# ---------------------------------------
#

use strict ;

# I need basename
use File::Basename ;

# I need getopt
use Getopt::Std ;

# Hostname is required for XML output
use Sys::Hostname;

# I like to have human-readable variables 
use English '-no_match_vars' ;

use Time::HiRes qw( gettimeofday tv_interval );

# For the option's management
my $options = "hdTqcf:D:ex:" ;
my %opt ;
my $usage = sprintf("Usage: %s [-h] [-q][-c][-e][-x <tag>][-f <config_file>] [-T] [-D var1=value[,var2=value[,...]]] test_name\n"
                   ."    -h : print this help\n"
                   ."    -q : quiet mode\n"
                   ."    -c : colored mode\n"
                   ."    -x : xml mode\n"
                   ."    -e : error only mode. Test only error conditions\n"
                   ."         and consider test as OK if none of them appear.\n"
                   ."    -f <config_file> : specify a config file\n"
                   ."    -T : test the content of the config file\n"
                   ."    -D var=value,var=value,... : define some\n"
                   ."       parameters to be used in the config file.\n"
                   ."    -d : debug mode\n",
                   basename( $0 ));
                   
my $DefaultConfFile = "./maketest.conf" ;

my $quiet_mode = 0;
my $colored_mode = 0;
my $xml_mode = 0;
my $xml_tag = 0;
my $debug = 0;
my $error_only = 0;
my $output_xml = "" ;
my $output_xml_stderr = "" ;
my $output_xml_stdout = "" ;

# definition des elements parametrables du fichier de configuration
my %hash_vars = ();

# This routine parses the -D option and fills the hash_vars array
sub Parse_D_opt
{
  my ($in_str)=@_;
  
  my ($var,$val,$reste);
  
  while ( $in_str =~ m/^([^=]+)=([^,]+),(.*)/ )
  {
    ($var, $val, $reste ) = ( $1, $2, $3 );
    
    print( "$var = $val\n" ) if ($debug );
    
    $hash_vars{ $var } = $val;
    $in_str = $reste;
  }
  
  # last one
  if ( $in_str =~ m/^([^=]+)=([^,]+)$/ )
  {
    ($var, $val) = ($1,$2);
    
    print( "$var = $val\n" ) if ( $debug );
    $hash_vars{ $var } = $val;  
  }
  
}



# Arg = none 
# Return = casimir ends (an exit is done)

# This routine reads the configuration file and build a hash table with all the information 
# arg 1 = path to the configuration file
# return = the resulting hash table
# 
# The structure of the resulting hash is a bit complex. Here is a sample of a resulting hash
# 0  'titi'
# 1  HASH(0x14257c)
#    'Command' => ' rpcinfo -u localhost portmap 2'
#    'Comment' => ' Tester la reponse au protocole portmapper version 2'
#    'Failure' => HASH(0x1435b0)
#       'tata' => '           STATUS == 1
#             OR
#           STDOUT =~ /Program or registered/' 
#       'toto' => '           STATUS != 0
#              OR
#            STDOUT =~ /Program or registered/'
#    'Product' => ' portmap'
#    'Success' => HASH(0x143550)
#       'ReadyAndWaiting' => '          STATUS == 0
#             AND
#           STDOUT =~ /ready and waiting/'
# 2  'gogol1'
# 3  HASH(0x12ecc0)
#    'Command' => ' gogol -s 3 '
#    'Comment' => ' Tester la reponse au protocole gogol version 3'
#    'Failure' => HASH(0x13a3a4)
#      'golmon' => '        '
#    'Product' => ' gogol'
#    'Success' => HASH(0x12ec78)
#       'machin' => "\cItototo"
#
# The base file for this was:
#
# Test titi
# {
#    Product = portmap
#   Command = rpcinfo -u localhost portmap 2
#   Comment = Tester la reponse au protocole portmapper version 2
# 
#         # ReadyAndWaiting
#         Success ReadyAndWaiting
#         {
#           STATUS == 0
#             AND
#           STDOUT =~ /ready and waiting/
#         }
# 
#         Failure toto
#         {
#            STATUS != 0
#              OR
#            STDOUT =~ /Program or registered/
#         }
# 
#         Failure tata
#         {
#            STATUS == 1
#              OR
#            STDOUT =~ /Program or registered/
#         }
# 
# 
# }
# 
# Test gogol1
# {
#     Product = gogol
#     Command = gogol -s 3
#     Comment = Tester la reponse au protocole gogol version 3
# 
#         # truc
#         Success machin
#         {
#         tototo
#         }
# 
#         Failure golmon
#         {
#          }
 
sub read_conf
{
    my %hashresult ;
    my $path = $_[0] ;
    my $filecontent ;
    my @definedTests ;
    my $iterTests ;
    my @listresult  = ();

    # slurp mode
    undef $/ ;

    # Let's open the file
    open( CONFFILE, "<$path" ) or die "Cannot open file $path: $!\n" ;
    $filecontent = <CONFFILE> ;
    close CONFFILE ;

    # replaces the variables into the config
    
    my $var;
    
    foreach $var ( keys %hash_vars )
    {
      my $val = $hash_vars{ $var };
      
      $filecontent =~ s#\$\($var\)#$val#mg ;
            
    }
    

    # This regexp is designed to put every test definition in one entry of @definedTests
    @definedTests = $filecontent =~ m/(
	                                Test \s* [0-9a-zA-Z_.]+ \s* \n                 # Header of a test clause
	                                \{
				          (?:                         
                                            (?:\s* \# .*? \n )            | # comments are allowed if preceeded by a '#'
				            (?:\s* Success \s* [0-9a-zA-Z_.]+ \s* \n   # Definition of the 'Success' clause
					     \s* \{ \s* \n	
					     (?: \s* \.*? \n)*
					     \s* \} \s* \n
					     )                            |
				             (?:\s* Failure \s* [0-9a-zA-Z_.]+ \s* \n   # Definition of the 'Failure' clause
					     \s* \{ \s* \n	
					     (?: \s* \.*? \n)*
					     \s* \} \s* \n
					      )                           |
				              (?:\s* \n)                  |    # Blank lines can be used, too
					      (?:\s* Product \s* = .*?\n) |    # 'Product' keyword definition
					      (?:\s* Command \s* = .*?\n) |    # 'Command' keyword definition
					      (?:\s* Comment \s* = .*?\n)      # 'Comment' keyword definition
					   )
					\}
				      )
				     /mxgs ;

    foreach $iterTests ( @definedTests )
    {
	my %hashTest    = () ;
	my %hashSuccess = () ;
	my %hashFailure = () ;

	my ($Test)    = $iterTests =~ m/ Test \s* ([0-9a-zA-Z_.]+) \s* \n /x ;
	my ($Product) = $iterTests =~ m/ Product \s* = (.*?) \n /x ;
	my ($Command) = $iterTests =~ m/ Command \s* = (.*?) \n /x ;
	my ($Comment) = $iterTests =~ m/ Comment \s* = (.*?) \n /x ;
	
    # concat the optional argument string
    $Command .= " " . $opt{ A } if (defined($opt{ A }));
    
	my @SuccessTab = $iterTests =~ m/ Success \s* ([0-9a-zA-Z_.]+) \s* \n    # Structure d'une clause Success
	                               \s* \{ \s* \n
					(\s* .*?)
					\s* \} \s* \n   /mxgs ;
	
	my @FailureTab = $iterTests =~ m/ Failure \s* ([0-9a-zA-Z_.]+) \s* \n  # Structure d'une clause Failure
	                                                   \s* \{ \s* \n
							   (\s* .*?)
							   \s* \} \s* \n   /mxgs ;

	while ( 1 ) 
	{
	    last if $#SuccessTab == -1 ;
	    my $SuccessCombo = pop @SuccessTab ;
	    my $SuccessName = pop @SuccessTab ;
	    $hashSuccess{ $SuccessName } = $SuccessCombo ;
	}
	
	while ( 1 ) 
	{
	    last if $#FailureTab == -1 ;
	    my $FailureCombo = pop @FailureTab ;
	    my $FailureName = pop @FailureTab ;
	    $hashFailure{ $FailureName } = $FailureCombo ;
	}
	
	$hashTest{ Product } = $Product ;
	$hashTest{ Command } = $Command ;
	$hashTest{ Comment } = $Comment ;	
	$hashTest{ Success } = \%hashSuccess ;
	$hashTest{ Failure } = \%hashFailure ;
	$hashresult{ $Test } = \%hashTest ;

	push @listresult, $Test ;
    }
    return ( \%hashresult, \@listresult )  ;
} # read_conf

# Arg 1 = reference to a hash produced by read_conf 
# Return = Nothing, just print the result on stdout
sub print_conf 
{
  my $k ;
  my $l ;
  my $refhash = $_[0] ;

  foreach $k ( keys %$refhash )
   {
     print ">>>>>> $k\n" ;
     print "   Product = ${$$refhash{ $k }}{ Product } \n";
     print "   Command = ${$$refhash{ $k }}{ Command } \n";
     print "   Comment = ${$$refhash{ $k }}{ Comment } \n";

     foreach $l ( keys %{${$$refhash{ $k }}{ Success }} )
     {
	print "   Success    $l\n" ;
	print " ${${$$refhash{ $k }}{ Success }}{ $l } \n" ;
     }

     foreach $l ( keys %{${$$refhash{ $k }}{ Failure }} )
     {
	print "   Failure    $l\n" ;
        print " ${${$$refhash{ $k }}{ Failure }}{ $l } \n" ;
     }
  }
} # print_conf

# This function translate a Success/Failure clause to a valid PERL code 
# used to run the test
# ARG 1 = the clause
# RETURN = the PERL expression
sub translate_clause
{
    my $testop = $_[0] ;
  
 
    $testop =~ s#STATUS#( \$STATUS#mg ;
    $testop =~ s#STDOUT#( \$STDOUT#mg ;
    $testop =~ s#STDERR#( \$STDERR#mg ;
    
    $testop =~ s#\s*\n#) \n#mg ;
    
    $testop =~ s#AND\)# and #mg ;
    $testop =~ s#OR\)# or #mg ;
    $testop =~ s#NOT\)# not #mg ;
		
    $testop =~ s#\A#if (  #mg;
    $testop =~ s#\Z# ) )#mg ;
	
    $testop .= "\n{\n \$testok = 1 ; \n} \nelse\n{ \n \$testok = 0 ; \n} \n;" ;

} # translate_clause


sub red_string
{
  my ($string)=@_;
  
  if ( !$colored_mode )
  {
    return $string;
  }
  else
  {
    return "[1;31m".$string."[0;39m";
  }  
}

sub green_string
{
  my ($string)=@_;
  
  if ( !$colored_mode )
  {
    return $string;
  }
  else
  {
    return "[1;32m".$string."[0;39m";
  }  
}

sub orange_string
{
  my ($string)=@_;
  
  if ( !$colored_mode )
  {
    return $string;
  }
  else
  {
    return "[1;35m".$string."[0;39m";
  }  
}


# This function does the test given as an input 
# ARG 1 = test's name
# ARG 2  = hash table related to the test 
# RETURN = 0 if successfull. 1 if failed, 2 if no failure or success were found. The output shows the failure's reason 
sub do_test
{
    my $testname = $_[0] ;
    my $refhash  = $_[1] ;

    my $failfound = 0 ;
    my $succfound = 0 ;

    my %hashSuccess = %{$$refhash{ 'Success' }} ;
    my %hashFailure = %{$$refhash{ 'Failure' }} ;

    my $stdoutfile = "/tmp/$testname.stdout.$$" ;
    my $stderrfile = "/tmp/$testname.stderr.$$" ;
    my $statusfile = "/tmp/$testname.status.$$" ;

    my $result_test = -1 ;

    my $timer_start  ;
    my $timer_end  ;
    my $timer_delta ;

    print "Now performing test '", $testname, "'\n" if( !$quiet_mode && !$xml_mode);
    print "    Product = $$refhash{ 'Product' } \n" if( !$quiet_mode && !$xml_mode);
    print "    Comment = $$refhash{ 'Comment' } \n" if( !$quiet_mode && !$xml_mode);
    print "    Command = $$refhash{ 'Command' } \n" if( !$quiet_mode && !$xml_mode);


    $timer_start = [gettimeofday()] ;
    my $cmd =  $$refhash{ 'Command' } ; 
    $timer_end = [gettimeofday()]  ;
    $timer_delta = sprintf( "%.6f",tv_interval( $timer_start, $timer_end ) ) ;

    $output_xml .= "<testcase classname=\"$xml_tag\" name=\"$testname\" time=\"$timer_delta\">\n" if( $xml_mode ) ;

    $cmd .= " 2>$stderrfile 1>$stdoutfile ; " . ' echo "STATUS=$?"' . " >$statusfile" ;
    print "===> Running $cmd \n" if( $debug ) ;
    system $cmd ;
    print "End of run for test '$testname', now parsing results\n"  if( !$quiet_mode && !$xml_mode);

    # reading file will be done using slurp mode
    undef $/ ;

    # Dealing with STDOUT
    open( STDOUTFILE, "<$stdoutfile" ) or die "Cannot open stdout file $stdoutfile: $!\n" ;
    my $STDOUT = <STDOUTFILE> ;
    close STDOUTFILE ;
    unlink $stdoutfile or print "Unlink to $stdoutfile is impossible: $!\n" ;
    if( $xml_mode ) { $output_xml_stdout .=  $STDOUT  } ;
    print "out#$STDOUT#\n" if( $debug ); ;
    
    # Dealing with STDERR
    open( STDERRFILE, "<$stderrfile" ) or die "Cannot open stderr file $stdoutfile: $!\n" ;
    my $STDERR = <STDERRFILE> ;
    close STDERRFILE ;
    print "err#$STDERR#\n" if( $debug );
    unlink $stderrfile or print "Unlink to $stderrfile is impossible: $!\n" ; 
    if( $xml_mode ) { $output_xml_stderr .=  $STDERR  } ;

    # Now dealing with STATUS
    open( STATUSFILE, "<$statusfile" ) or die "Cannot open status file $statusfile: $!\n" ;
    my $statusfilecontent = <STATUSFILE> ;
    close STATUSFILE ;
    unlink $statusfile or print "Unlink to $statusfile is impossible: $!\n" ;
    
    # It is now time to evaluate the status 
    my $STATUS = -10000 ;  # Dumb value 
    $statusfilecontent =~ s#^STATUS#\$STATUS#;
    $statusfilecontent =~ s#$#;# ;
    eval $statusfilecontent ;
    print "STATUS = $STATUS \n" if( $debug );


    # Now, we parse the results  
    
    if ( ! $error_only )
    {
      my $succ ; 
      foreach $succ ( keys %hashSuccess )
      {
        my $testop = translate_clause( $hashSuccess{ $succ } ) ;

        my $testok = -1567 ; # Dumb value
        eval $testop ;
        print "~~~~~~> $testok \n" if( $debug );

        if( $testok == 1 )
        {
            if( $quiet_mode )
            {
              print "    $testname  [ " .green_string($succ) . " ]\n" if( !$xml_mode ) ;
            }
            else
            {
              print "    Test $testname has successfull status ".green_string($succ)."\n" if( !$xml_mode ) ;
            }

	        $succfound = 1 ;
	        $result_test = 0 ;
        }
      }
    } #error_only
    
    my $fail ;
    foreach $fail ( keys %hashFailure )
    {
	  my $testop = translate_clause( $hashFailure{ $fail } ) ;

	  my $testok = -1567 ; # Dumb value
	  eval $testop ;
	  print "~~~~~~> $testok \n" if( $debug ) ;

	  if( $testok == 1 )
	  {
          if( $quiet_mode )
          {
            print "    $testname  [ ".red_string($fail)." ]\n" if( !$xml_mode ) ;
          }
          else
          {
            print "    Test $testname has recognized failure ".red_string($fail)."\n" if( !$xml_mode ) ;
          }

          if( $xml_mode ) 
          {
              $output_xml .= "<failure type=".'"'."$fail".'">' ;
              $output_xml .= "Test $testname has recognized failure $fail\n" ;
              $output_xml .= "</failure>\n"  ;
          }

  	      $failfound = 1 ;
	      $result_test = 1 ;
	  }
    }
     
    # If no success or failure were identify, then tell it
    if( !$failfound && !$succfound )
    {
      if ( ! $error_only )
      {
          if( $quiet_mode )
          {
            print "    $testname  [ ". orange_string("NO STATUS")." ]\n" if( !$xml_mode ) ;
          }
          else
          {
            print "    ".orange_string("No success or failure could be found")." for test $testname\n" if( !$xml_mode ) ;;
          }

         if( $xml_mode ) 
          {
              $output_xml .= "<failure type=".'"'."unrecognized".'">' ;
              $output_xml .= "Test $testname has unrecognized failure\n" ;
              $output_xml .= "</failure>\n"  ;
          }

          $result_test = 2 ;
      }
      else # test is considered as OK
      {
            if( $quiet_mode )
            {
              print "    $testname  [ " .green_string("OK") . " ]\n" if( !$xml_mode ) ;
            }
            else
            {
              print "    Test $testname has successfull status ".green_string("OK")."\n" if( !$xml_mode ) ;
            }

	    $result_test = 0 ;          
      }
    }

    $output_xml .= "</testcase>\n" if( $xml_mode ) ;
    print "------------------------------------------------------\n" if( !$quiet_mode && !$xml_mode ) ;
    return $result_test ;
} # do_test 

##################
# MAIN PROCEDURE #
##################

# Let's process the options
getopts( $options, \%opt ) or die "Incorrect option used\n$usage\n" ;

# command line help
if( $opt{ h } )
{
    print "$usage\n" ;
    exit( 1 ) ;
}

# What is my configuration file ?
my $ConfFile = $opt{ f } || $DefaultConfFile ;

$quiet_mode = defined( $opt{ q } );
$colored_mode = defined( $opt{ c } );
$xml_mode = defined( $opt{ x } );
$xml_tag =  $opt{ x } if defined( $opt{ x } ) ;
$debug = defined( $opt{ d } );
$error_only = defined( $opt{ e } );


if ( defined( $opt{ D } ) )
{
  Parse_D_opt( $opt{ D } );
}


# Now we read the configuration file
my ( $hashconfref, $listconfref ) = read_conf $ConfFile ;
my %hashconf = %$hashconfref ;
my @listconf = @$listconfref ;

# If flag -T is used, this is the test mode. The configuration file is just parsed
if( $opt{ T }  )
{ 
    print_conf $hashconfref ;
    exit( 0 ) ;
}


# Now build the list of tests to be done
my @testlist ;

if ( $#ARGV == -1 ) 
{
    # If no test's name is supplied, then do all the tests
    # @testlist = keys %hashconf ;
    @testlist = @listconf ; 
}
else
{
    @testlist = @ARGV ;
}

# It now time to performs the tests
my $test ;
my $NbFailed        = 0 ;
my $NbSuccess       = 0 ;
my $NbIndeterminate = 0 ;
my $NbTotal         = 0 ;
my $res ;

print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" if( $xml_mode ) ; 


foreach $test ( @testlist )
{
    if( defined( $hashconf{ $test } ) )
    {
	$res = do_test( $test, $hashconf{ $test } ) ;
	if( $res == 0 ) { $NbSuccess += 1 ; } ;
	if( $res == 1 ) { $NbFailed  += 1 ; } ;
	if( $res == 2 ) { $NbIndeterminate += 1 } ;
        $NbTotal += 1 ;
    }
    else
    {
	print "Test '", $test, "' is not defined in the configuration file\n" ;
    }
}

if( $NbFailed != 0 )
{
    print "    Summary: $NbFailed test(s) failed\n" if( !$xml_mode ) ;
}

if( $NbIndeterminate != 0 )
{
    print "    Summary: $NbIndeterminate test(s) had indeterminate status\n" if( !$xml_mode )  ;
}

if( ( $NbFailed == 0 )&& ( $NbIndeterminate == 0 ) )
{
    print "    Summary: All the requested test(s) were successfull\n" if( !$xml_mode );
}

if( $xml_mode ) 
{

  print"<testsuite errors=\"0\" failures=\"$NbFailed\" hostname=\"".hostname."\" name=\"maketest\" tests=\"$NbTotal\" time=\"0.0\">\n" ;
  print $output_xml ;
  ##print "<system-out>No system out displayed by maketest</system-out>\n" ;
  ##print "<system-err>No system err displayed by maketest</system-err>\n" ;

  # Remove < and > from XML
  #$output_xml_stdout =~ s/\</_sup_/g ;
  #$output_xml_stdout =~ s/\>/_inf_/g ;

  #$output_xml_stderr =~ s/\</_sup_/g ;
  #$output_xml_stderr =~ s/\>/_inf_/g ;

  print "<system-out><![CDATA[$output_xml_stdout]]></system-out>\n" ;
  print "<system-err><![CDATA[$output_xml_stderr]]></system-err>\n" ;

  print "</testsuite>\n" ;
}
